home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue37 / system / RFMain.pas < prev   
Encoding:
Pascal/Delphi Source File  |  1998-07-27  |  11.1 KB  |  309 lines

  1. unit RFMain;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   StdCtrls, Registry, ComCtrls, IniFiles;
  8.  
  9. type
  10.     TForm1 = class(TForm)
  11.         AssociationList: TListBox;
  12.         FileTypesLabel: TLabel;
  13.         HeaderControl1: THeaderControl;
  14.         Backup: TButton;
  15.         SaveDialog: TSaveDialog;
  16.         Restore: TButton;
  17.         OpenDialog: TOpenDialog;
  18.         procedure FormCreate(Sender: TObject);
  19.         procedure FormDestroy(Sender: TObject);
  20.         procedure AssociationListDrawItem(Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  21.         procedure HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
  22.         procedure HeaderControl1SectionClick(HeaderControl: THeaderControl; Section: THeaderSection);
  23.         procedure AssociationListKeyDown(Sender: TObject; var Key: Word; Shift: TShiftState);
  24.         procedure BackupClick(Sender: TObject);
  25.         procedure RestoreClick(Sender: TObject);
  26.     procedure AssociationListDblClick(Sender: TObject);
  27.     private
  28.         { Private declarations }
  29.         SysReg: TRegIniFile;             { For accessing system registry }
  30.         ShowDesc: Boolean;               { True for descriptions, False for associations }
  31.         HeaderZeroSize: Integer;         { A little hackette for on-the-fly header resizing }
  32.         function GetStr (S: String; Idx: Integer): String;
  33.         procedure DeleteItem (const ItemString: String);
  34.         procedure RestoreAssociation (IniFile: TIniFile; const Extension: String);
  35.         procedure PutAssociation (const Str: String);
  36.         procedure LoadAssociations;
  37.     public
  38.         { Public declarations }
  39.     end;
  40.  
  41. var
  42.   Form1: TForm1;
  43.  
  44. implementation
  45.  
  46. {$R *.DFM}
  47.  
  48. uses EditAssoc;
  49.  
  50. const
  51.     Delimiter = '|';
  52.  
  53.     // The following constants make it easier to use GetStr
  54.  
  55.     gs_Extension = 0;          // Extension of filename
  56.     gs_Lev2Name  = 1;          // Name of second level reg key
  57.     gs_Descrip   = 2;          // Plain-English description
  58.     gs_Command   = 3;          // Command string
  59.     gs_DDE       = 4;          // DDE string
  60.  
  61. function TForm1.GetStr (S: String; Idx: Integer): String;
  62. var
  63.     IdxPos: Integer;
  64. begin
  65.     while Idx <> 0 do begin
  66.         IdxPos := Pos (Delimiter, S);
  67.         S := Copy (S, IdxPos + 1, MaxInt);
  68.         Dec (Idx);
  69.     end;
  70.  
  71.     IdxPos := Pos (Delimiter, S);
  72.     if IdxPos = 0 then IdxPos := MaxInt;
  73.     Result := Copy (S, 1, IdxPos - 1);
  74. end;
  75.  
  76. procedure TForm1.LoadAssociations;
  77. var
  78.     Idx: Integer;
  79.     SubKeys, FileExts: TStringList;
  80.     Str, Desc, Cmd, CurSubKeyName: String;
  81.     Data: String;
  82. begin
  83.     AssociationList.Items.Clear;
  84.  
  85.     { Create a temporary stringlist for holding raw subkey names }
  86.     SubKeys := TStringList.Create;
  87.  
  88.     { And another for holding tab-delimited file extensions }
  89.     FileExts := TStringList.Create;
  90.     try
  91.         SysReg.ReadSections (SubKeys);
  92.         for Idx := SubKeys.Count - 1 downto 0 do begin
  93.             CurSubKeyName := SubKeys [Idx];
  94.             if CurSubKeyName [1] = '.' then begin
  95.                 Data := CurSubKeyName + Delimiter;
  96.                 Str := SysReg.ReadString (CurSubKeyName, '', '');
  97.                 if Str <> '' then begin
  98.                     Data := Data + Str + Delimiter;
  99.                     Desc := SysReg.ReadString (Str, '', '');
  100.                     if Desc <> '' then begin
  101.                         Data := Data + Desc + Delimiter;
  102.                         Cmd := SysReg.ReadString (Str + '\shell\open\command', '', '');
  103.                         if Cmd <> '' then begin
  104.                             Data := Data + Cmd + Delimiter;
  105.                             if SysReg.KeyExists (Str + '\shell\open\ddeexec') then
  106.                                 Data := Data + 'Y'
  107.                             else
  108.                                 Data := Data + 'N';
  109.                             FileExts.Add (Data);
  110.                         end;
  111.                     end;
  112.                 end;
  113.             end;
  114.         end;
  115.  
  116.         AssociationList.Items.Assign (FileExts);
  117.         AssociationList.ItemIndex := 0;
  118.         FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
  119.     finally
  120.         SubKeys.Free;
  121.         FileExts.Free;
  122.     end;
  123. end;
  124.  
  125. procedure TForm1.FormCreate(Sender: TObject);
  126. begin
  127.     { Open the registry and access the hKey_Classes_Root hive }
  128.     SysReg := TRegIniFile.Create ('');
  129.     SysReg.RootKey := hKey_Classes_Root;
  130.     SysReg.OpenKey ('', False);
  131.     LoadAssociations;
  132.     ShowDesc := True;
  133.     HeaderZeroSize := HeaderControl1.Sections [0].Width;
  134. end;
  135.  
  136. procedure TForm1.FormDestroy(Sender: TObject);
  137. begin
  138.     SysReg.Free;
  139. end;
  140.  
  141. procedure TForm1.AssociationListDrawItem (Control: TWinControl; Index: Integer; Rect: TRect; State: TOwnerDrawState);
  142. var
  143.     Idx: Integer;
  144.     ItemString: String;
  145. begin
  146.     with AssociationList.Canvas do begin
  147.         FillRect (Rect);
  148.         if odSelected in State then Font.Style := Font.Style + [fsBold];
  149.  
  150.         ItemString := AssociationList.Items [Index];
  151.         TextOut (Rect.Left + 5, Rect.Top, GetStr (ItemString, gs_Extension));
  152.         if ShowDesc then Idx := gs_Descrip else Idx := gs_Command;
  153.         TextOut (HeaderZeroSize, Rect.Top, GetStr (ItemString, Idx));
  154.     end;
  155. end;
  156.  
  157. procedure TForm1.HeaderControl1SectionTrack(HeaderControl: THeaderControl; Section: THeaderSection; Width: Integer; State: TSectionTrackState);
  158. begin
  159.     if State = tsTrackMove then begin
  160.         HeaderZeroSize := Width;
  161.         AssociationList.Invalidate;
  162.     end;
  163. end;
  164.  
  165. procedure TForm1.HeaderControl1SectionClick (HeaderControl: THeaderControl; Section: THeaderSection);
  166. begin
  167.     if Section = HeaderControl1.Sections [1] then begin
  168.         ShowDesc := not ShowDesc;
  169.         if ShowDesc then Section.Text := 'File Description' else Section.Text := 'File Association';
  170.         AssociationList.Invalidate;
  171.     end;
  172. end;
  173.  
  174. procedure TForm1.DeleteItem (const ItemString: String);
  175. begin
  176.     with AssociationList do begin
  177.         Items.Delete (ItemIndex);
  178.         ItemIndex := 0;
  179.         FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
  180.         { Now delete the registry stuff too }
  181.         SysReg.EraseSection (SysReg.ReadString (GetStr (ItemString, gs_Extension), '', ''));
  182.         SysReg.EraseSection (GetStr (ItemString, gs_Extension));
  183.     end;
  184. end;
  185.  
  186. procedure TForm1.AssociationListKeyDown (Sender: TObject; var Key: Word; Shift: TShiftState);
  187. var
  188.     ItemString: String;
  189. begin
  190.     if Key = vk_Delete then with AssociationList do begin
  191.         ItemString := Items [ItemIndex];
  192.         if MessageDlg (Format ('Remove all registry entries for ''%s''?',
  193.                        [GetStr (ItemString, gs_Extension)]), mtConfirmation, [mbYes, mbNo], 0) = mrYes then
  194.                        DeleteItem (ItemString);
  195.     end;
  196. end;
  197.  
  198. procedure TForm1.BackupClick(Sender: TObject);
  199. var
  200.     Idx: Integer;
  201.     IniFile: TIniFile;
  202.     ItemString, KeyName: String;
  203. begin
  204.     if SaveDialog.Execute then begin
  205.         IniFile := TIniFile.Create (SaveDialog.FileName);
  206.         try
  207.             for Idx := 0 to AssociationList.Items.Count - 1 do begin
  208.                 ItemString := AssociationList.Items [Idx];
  209.                 KeyName := GetStr (ItemString, gs_Extension);
  210.                 FileTypesLabel.Caption := Format ('Saving info for %s', [KeyName]);
  211.                 IniFile.WriteString ('Associations', KeyName, Copy (ItemString, Length (KeyName) + 2, MaxInt));
  212.             end;
  213.         finally
  214.             FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
  215.             IniFile.Free;
  216.         end;
  217.     end;
  218. end;
  219.  
  220. procedure TForm1.RestoreClick(Sender: TObject);
  221. var
  222.     Idx: Integer;
  223.     cursOld: hCursor;
  224.     IniFile: TIniFile;
  225.     KeyNames: TStringList;
  226. begin
  227.     if OpenDialog.Execute then begin
  228.         Inifile := TIniFile.Create (OpenDialog.FileName);
  229.         try
  230.             KeyNames := TStringList.Create;
  231.             cursOld := SetCursor (LoadCursor (0, idc_Wait));
  232.             try
  233.                 IniFile.ReadSection ('Associations', KeyNames);
  234.                 if KeyNames.Count = 0 then ShowMessage ('File is invalid or empty') else begin
  235.                     for Idx := 0 to KeyNames.Count - 1 do
  236.                         RestoreAssociation (IniFile, KeyNames [Idx]);
  237.                     LoadAssociations;
  238.                 end;    
  239.             finally
  240.                 SetCursor (cursOld);
  241.                 FileTypesLabel.Caption := Format ('Registered File &Count = %d', [AssociationList.Items.Count]);
  242.                 KeyNames.Free;
  243.             end;
  244.         finally
  245.             IniFile.Free;
  246.         end;
  247.     end;
  248. end;
  249.  
  250. procedure TForm1.PutAssociation (const Str: String);
  251. var
  252.     Lev2Name: String;
  253. begin
  254.     // First, write the Level-1 entry
  255.     SysReg.WriteString (GetStr (Str, gs_Extension), '', GetStr (Str, gs_Lev2Name));
  256.     // Next, write the Level-2 description field
  257.     Lev2Name := GetStr (Str, gs_Lev2Name);
  258.     SysReg.WriteString (Lev2Name, '', GetStr (Str, gs_Descrip));
  259.     // Write the Level-2 command field
  260.     SysReg.WriteString (Lev2Name + '\shell\open\command', '', GetStr (Str, gs_Command));
  261.     // Finally, see if we should nuke the DDEEXEC tree.
  262.     if GetStr (Str, gs_DDE) = 'N' then
  263.         if SysReg.KeyExists (Lev2Name + '\shell\open\ddeexec') then
  264.             SysReg.EraseSection (Lev2Name + '\shell\open\ddeexec');
  265. end;
  266.  
  267. procedure TForm1.RestoreAssociation (IniFile: TIniFile; const Extension: String);
  268. var
  269.     Str: String;
  270. begin
  271.     FileTypesLabel.Caption := Format ('Restoring info for %s', [Extension]);
  272.     Str := Extension + Delimiter + IniFile.ReadString ('Associations', Extension, '');
  273.     // If extension no longer in registry, *DONT* try to restore it
  274.     if SysReg.KeyExists (Extension) then PutAssociation (Str);
  275. end;
  276.  
  277. procedure TForm1.AssociationListDblClick(Sender: TObject);
  278. var
  279.     Str: String;
  280.     Idx: Integer;
  281. begin
  282.     if AssociationList.ItemIndex <> -1 then
  283.         with TEditAssociation.Create (Application) do try
  284.             Idx := AssociationList.ItemIndex;
  285.             Str := AssociationList.Items [Idx];
  286.             Extension.Caption := Format (Extension.Caption, [GetStr (Str, gs_Extension)]);
  287.             AssocPath.Text := GetStr (Str, gs_Command);
  288.             if ShowModal = mrOK then begin
  289.                 // Reassemble item-list box string
  290.                 Str := GetStr (Str, gs_Extension) + Delimiter +
  291.                        GetStr (Str, gs_Lev2Name) + Delimiter +
  292.                        GetStr (Str, gs_Descrip) + Delimiter +
  293.                        AssocPath.Text + Delimiter +
  294.                        GetStr (Str, gs_DDE);
  295.                 // Update the list-box
  296.                 AssociationList.Items.Delete (Idx);
  297.                 AssociationList.Items.Insert (Idx, Str);
  298.                 AssociationList.ItemIndex := Idx;
  299.                 AssociationList.Invalidate;
  300.                 // And update the registry
  301.                 PutAssociation (Str);
  302.             end;
  303.         finally
  304.             Free;
  305.         end;
  306. end;
  307.  
  308. end.
  309.